home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / lalr.lha / lalr / src / GenLang.mi < prev    next >
Text File  |  1992-08-18  |  14KB  |  499 lines
  1. (* generate source parts of the parser *)
  2.  
  3. (* $Id: GenLang.mi,v 1.10 1992/08/07 15:22:49 grosch rel $ *)
  4.  
  5. (* $Log: GenLang.mi,v $
  6.  * Revision 1.10  1992/08/07  15:22:49  grosch
  7.  * allow several scanner and parsers; extend module Errors
  8.  *
  9.  * Revision 1.9  1992/01/30  14:08:30  grosch
  10.  * redesign of interface to operating system
  11.  *
  12.  * Revision 1.8  1991/12/04  16:23:39  grosch
  13.  * unified escape conventions for all tools
  14.  *
  15.  * Revision 1.7  1991/11/21  14:53:14  grosch
  16.  * new version of RCS on SPARC
  17.  *
  18.  * Revision 1.6  90/12/20  19:26:42  grosch
  19.  * removed time stamp from tables
  20.  * 
  21.  * Revision 1.5  90/09/20  17:52:31  grosch
  22.  * calmed down lint
  23.  * 
  24.  * Revision 1.4  90/06/12  17:17:23  grosch
  25.  * layout improvements
  26.  * 
  27.  * Revision 1.3  90/06/12  16:54:16  grosch
  28.  * renamed main program to lalr, added { } for actions, layout improvements
  29.  * 
  30.  * Revision 1.2     89/05/02  14:36:38  vielsack
  31.  * $$ is used instead of $0
  32.  * $0, $-1, $-2, .. are legal now
  33.  * attribute access is changed for the stacks are now dynamic arrays
  34.  * 
  35.  * Revision 1.1     89/01/12  18:09:43  vielsack
  36.  * line number is printed before an action is output
  37.  * 
  38.  * Revision 1.0     88/10/04  14:36:23  vielsack
  39.  * Initial revision
  40.  * 
  41.  *)
  42.  
  43. IMPLEMENTATION MODULE GenLang; (* Erzeugung von Modula2- oder C-Quelltexten *)
  44.  
  45. FROM Automaton    IMPORT tIndex, tStateIndex, tProdIndex, tProduction, ProdIndex, ProdArrayPtr, NextProdIndex;
  46. FROM Compress    IMPORT NTableSize, TableSize;
  47. FROM DynArray    IMPORT ReleaseArray;
  48. FROM ArgCheck    IMPORT LineFlag;
  49. FROM Gen    IMPORT NonTermOffset, FirstTerminal, LastTerminal, FirstSymbol,
  50.             LastSymbol, FirstReadState, LastReadState, FirstReadTermState,
  51.             LastReadTermState, FirstReadNonTermState, LastReadNonTermState,
  52.             FirstReduceState, LastReduceState, StartState, StopState,
  53.             CaseLabels, CaseFlag;
  54. FROM IO        IMPORT tFile, WriteNl, WriteI, WriteS, WriteC;
  55. FROM Lists    IMPORT tList, IsEmpty, Tail, Head;
  56. FROM Strings    IMPORT tStringIndex, tString, Char, Length;
  57. FROM StringMem    IMPORT tStringRef;
  58. IMPORT StringMem;   (* GetString *)
  59. FROM Idents    IMPORT tIdent, GetString;
  60. FROM SYSTEM    IMPORT TSIZE, ADR;
  61. FROM TokenTab    IMPORT PosType, TokenError, Vocabulary, TokenToSymbol;
  62. FROM WriteTok    IMPORT tLanguage, Language, SourceFileName;
  63.  
  64.   PROCEDURE WriteConstants (f: tFile); (* Ausgabe der Konstanten *)
  65.     BEGIN
  66.       IF Language = Modula2 THEN
  67.     WriteS (f, '   yyFirstTerminal        = ');
  68.     WriteI (f, FirstTerminal, 0); WriteC (f, ';'); WriteNl(f);
  69.     WriteS (f, '   yyLastTerminal        = ');
  70.     WriteI (f, LastTerminal, 0); WriteC (f, ';'); WriteNl(f);
  71.     WriteS (f, '   yyFirstSymbol        = ');
  72.     WriteI (f, FirstSymbol, 0); WriteC (f, ';'); WriteNl(f);
  73.     WriteS (f, '   yyLastSymbol        = ');
  74.     WriteI (f, LastSymbol, 0); WriteC (f, ';'); WriteNl(f);
  75.     WriteS (f, '   yyTableMax        = ');
  76.     WriteI (f, TableSize, 0); WriteC (f, ';'); WriteNl(f);
  77.     WriteS (f, '   yyNTableMax        = ');
  78.     WriteI (f, NTableSize, 0); WriteC (f, ';'); WriteNl(f);
  79.     WriteS (f, '   yyFirstReadState        = ');
  80.     WriteI (f, FirstReadState, 0); WriteC (f, ';'); WriteNl(f);
  81.     WriteS (f, '   yyLastReadState        = ');
  82.     WriteI (f, LastReadState, 0); WriteC (f, ';'); WriteNl(f);
  83.     WriteS (f, '   yyFirstReadTermState        = ');
  84.     WriteI (f, FirstReadTermState, 0); WriteC (f, ';'); WriteNl(f);
  85.     WriteS (f, '   yyLastReadTermState        = ');
  86.     WriteI (f, LastReadTermState, 0); WriteC (f, ';'); WriteNl(f);
  87. (*    WriteS (f, '   yyFirstReadNontermState        = ');
  88.     WriteI (f, FirstReadNonTermState, 0); WriteC (f, ';'); WriteNl(f);    *)
  89.     WriteS (f, '   yyLastReadNontermState        = ');
  90.     WriteI (f, LastReadNonTermState, 0); WriteC (f, ';'); WriteNl(f);
  91.     WriteS (f, '   yyFirstReduceState        = ');
  92.     WriteI (f, FirstReduceState, 0); WriteC (f, ';'); WriteNl(f);
  93.     WriteS (f, '   yyLastReduceState        = ');
  94.     WriteI (f, LastReduceState, 0); WriteC (f, ';'); WriteNl(f);
  95.     WriteS (f, '   yyStartState        = ');
  96.     WriteI (f, StartState(), 0); WriteC (f, ';'); WriteNl(f);
  97.     WriteS (f, '   yyStopState        = ');
  98.     WriteI (f, StopState, 0); WriteC (f, ';'); WriteNl(f);
  99.       ELSE (* Language = C *)
  100.     WriteS (f, '# define yyFirstTerminal    ');
  101.     WriteI (f, FirstTerminal, 0); WriteNl(f);
  102.     WriteS (f, '# define yyLastTerminal        ');
  103.     WriteI (f, LastTerminal, 0); WriteNl(f);
  104. (*    WriteS (f, '# define yyFirstSymbol    ');
  105.     WriteI (f, FirstSymbol, 0); WriteNl(f);
  106.     WriteS (f, '# define yyLastSymbol    ');
  107.     WriteI (f, LastSymbol, 0); WriteNl(f);        *)
  108.     WriteS (f, '# define yyTableMax        ');
  109.     WriteI (f, TableSize, 0); WriteNl(f);
  110.     WriteS (f, '# define yyNTableMax        ');
  111.     WriteI (f, NTableSize, 0); WriteNl(f);
  112.     WriteS (f, '# define yyFirstReadState    ');
  113.     WriteI (f, FirstReadState, 0); WriteNl(f);
  114.     WriteS (f, '# define yyLastReadState    ');
  115.     WriteI (f, LastReadState, 0); WriteNl(f);
  116.     WriteS (f, '# define yyFirstReadTermState    ');
  117.     WriteI (f, FirstReadTermState, 0); WriteNl(f);
  118.     WriteS (f, '# define yyLastReadTermState    ');
  119.     WriteI (f, LastReadTermState, 0); WriteNl(f);
  120. (*    WriteS (f, '# define yyFirstReadNontermState    ');
  121.     WriteI (f, FirstReadNonTermState, 0); WriteNl(f);    *)
  122.     WriteS (f, '# define yyLastReadNontermState    ');
  123.     WriteI (f, LastReadNonTermState, 0); WriteNl(f);
  124.     WriteS (f, '# define yyFirstReduceState    ');
  125.     WriteI (f, FirstReduceState, 0); WriteNl(f);
  126.     WriteS (f, '# define yyLastReduceState    ');
  127.     WriteI (f, LastReduceState, 0); WriteNl(f);
  128.     WriteS (f, '# define yyStartState        ');
  129.     WriteI (f, StartState(), 0); WriteNl(f);
  130.     WriteS (f, '# define yyStopState        ');
  131.     WriteI (f, StopState, 0); WriteNl(f);
  132.       END;
  133.     END WriteConstants;
  134.  
  135.   PROCEDURE WriteReduceCode (f:tFile); (* Ausgabe des Codes fuer die Reduktionen *)
  136.     VAR
  137.       label: tStateIndex;
  138.       labels: INTEGER;
  139.       cases: INTEGER;
  140.       index: tProdIndex;
  141.       prod: tProduction;
  142.       maxProdIndex: tProdIndex;
  143.       u: LONGINT;
  144.     BEGIN
  145.       label := FirstReduceState;
  146.       labels := 0;
  147.       cases := 1;
  148.       index := 0;
  149.  
  150.       IF CaseLabels > 0 THEN
  151.     INC (label, CaseLabels);
  152.     OpenCase (f, label);
  153.       ELSIF Language = Modula2 THEN
  154.     WriteS    (f, 'CASE yyState OF');
  155.     WriteNl (f);
  156.       ELSE (* Language = C *)
  157.     WriteS    (f, 'switch (yyState) {');
  158.     WriteNl (f);
  159.       END;
  160.  
  161.       maxProdIndex := ProdIndex;
  162.       WHILE index < maxProdIndex DO
  163.  
  164.     IF CaseLabels > 0 THEN
  165.       IF labels >= CaseLabels THEN
  166.         INC (label, CaseLabels);
  167.         NextCase (f, label);
  168.         INC (cases);
  169.         labels := 0;
  170.       END;
  171.       INC (labels);
  172.     END;
  173.  
  174.     prod := ADR (ProdArrayPtr^[index]);
  175.  
  176.     (* States ausgeben *)
  177.  
  178.     WITH prod^.Reduce DO
  179.       IF Language = Modula2 THEN
  180.         WriteS (f, '  | ');
  181.         WriteI (f, Array^[1], 0);
  182.       ELSE (* Language = C *)
  183.         WriteS (f, 'case ');
  184.         WriteI (f, Array^[1], 0);
  185.         WriteC (f, ':');
  186.       END;
  187.       IF NOT CaseFlag THEN
  188.         FOR u := 2 TO Used DO
  189.           IF Language = Modula2 THEN
  190.         WriteC (f, ',');
  191.         WriteI (f, Array^[u], 0);
  192.           ELSE (* Language = C *)
  193.         WriteNl (f);
  194.         WriteS (f, 'case ');
  195.         WriteI (f, Array^[u], 0);
  196.         WriteC (f, ':');
  197.           END;
  198.         END;
  199.       END;
  200.       IF Language = Modula2 THEN WriteC (f, ':'); END;
  201.       
  202.       WriteProdComment (f, prod);
  203.  
  204.       IF index = 0 THEN   (* Endzustand *)
  205.         IF Language = Modula2 THEN
  206.           WriteS (f, '  DynArray.ReleaseArray (yyStateStack, yyStateStackSize, SYSTEM.TSIZE (yyTableElmt));');
  207.           WriteNl (f);
  208.           WriteS (f, '  DynArray.ReleaseArray (yyAttributeStack, yyAttrStackSize, SYSTEM.TSIZE (tParsAttribute));');
  209.           WriteNl (f);
  210.           WriteS (f, '  RETURN yyErrorCount;');
  211.           WriteNl (f);
  212.         ELSE (* Language = C *)
  213.           WriteS (f, '  ReleaseArray ((char * *) & yyStateStack, & yyStateStackSize, sizeof (yyStateRange));');
  214.           WriteNl (f);
  215.           WriteS (f, '  ReleaseArray ((char * *) & yyAttributeStack, & yyAttrStackSize, sizeof (tParsAttribute));');
  216.           WriteNl (f);
  217.           WriteS (f, '  return yyErrorCount;');
  218.           WriteNl (f);
  219.         END;
  220.       ELSE
  221.         IF Language = Modula2 THEN
  222.           WriteS (f, '  DEC (yyStackPtr, ');
  223.           WriteI (f, prod^.Len, 0);
  224.           WriteS (f, '); yyNonterminal := ');
  225.           WriteI (f, prod^.Left-NonTermOffset, 0);
  226.           WriteS (f, ';');
  227.           WriteNl (f);
  228.         ELSE (* Language = C *)
  229.           WriteS (f, '  yyStateStackPtr -=');
  230.           WriteI (f, prod^.Len, 0);
  231.           WriteS (f, '; yyAttrStackPtr -=');
  232.           WriteI (f, prod^.Len, 0);
  233.           WriteS (f, '; yyNonterminal = ');
  234.           WriteI (f, prod^.Left-NonTermOffset, 0);
  235.           WriteS (f, '; {');
  236.           WriteNl (f);
  237.         END;
  238.       END;
  239.  
  240.       ReleaseArray (Array, Count, TSIZE (tIndex));
  241.     END;
  242.  
  243.     (* semantische Aktion ausgeben *)
  244.  
  245.     WriteSemanticAction (f, prod^.Act, prod^.Len, prod^.ActPos);
  246.     IF (index # 0) AND (Language = C) THEN
  247.       WriteS (f, '} break;'); WriteNl (f);
  248.     END;
  249.     index := NextProdIndex(index);
  250.       END;
  251.  
  252.       IF CaseLabels > 0 THEN
  253.     CloseCase (f, cases);
  254.       ELSIF Language = Modula2 THEN
  255.     WriteS    (f, 'END;');
  256.     WriteNl (f);
  257.       ELSE (* Language = C *)
  258.     WriteS    (f, '}');
  259.     WriteNl (f);
  260.       END;
  261.     END WriteReduceCode;
  262.   
  263.   PROCEDURE OpenCase (f: tFile; label: tStateIndex);
  264.     BEGIN
  265.       IF Language = Modula2 THEN
  266.     WriteS    (f, 'CASE yyState OF');
  267.     WriteNl (f);
  268.       ELSE (* Language = C *)
  269.     IF label <= LastReduceState THEN
  270.       WriteS  (f, 'if (yyState < ');
  271.       WriteI  (f, label, 0);
  272.       WriteS  (f, ') ');
  273.     END;
  274.     WriteS    (f, 'switch (yyState) {');
  275.     WriteNl (f);
  276.       END;
  277.     END OpenCase;
  278.  
  279.   PROCEDURE NextCase (f: tFile; label: tStateIndex);
  280.     BEGIN
  281.       IF Language = Modula2 THEN
  282.     WriteS    (f, 'ELSE CASE yyState OF');
  283.     WriteNl (f);
  284.       ELSE (* Language = C *)
  285.     WriteS    (f, '} else ');
  286.     IF label <= LastReduceState THEN
  287.       WriteS  (f, 'if (yyState < ');
  288.       WriteI  (f, label, 0);
  289.       WriteS  (f, ') ');
  290.     END;
  291.     WriteS    (f, 'switch (yyState) {');
  292.     WriteNl (f);
  293.       END;
  294.     END NextCase;
  295.  
  296.   PROCEDURE CloseCase (f: tFile; cases: INTEGER);
  297.     BEGIN
  298.       IF Language = Modula2 THEN
  299.     WHILE cases > 0 DO
  300.       WriteS  (f, 'END; (* additional CASE *)');
  301.       WriteNl (f);
  302.       DEC (cases);
  303.     END;
  304.       ELSE (* Language = C *)
  305.       WriteS  (f, '}');
  306.       WriteNl (f);
  307.       END;
  308.     END CloseCase;
  309.  
  310.   PROCEDURE WriteSemanticAction (f: tFile; a: tList; len: CARDINAL; pos: PosType);
  311.     VAR
  312.       c: CHAR;
  313.       s: tString;
  314.       i: tStringIndex;
  315.       i1, i2: tStringIndex;
  316.       AttrIndex: CARDINAL;
  317.       negative: BOOLEAN;
  318.       Delimiter : CHAR;
  319.     BEGIN
  320.       IF pos.Line # 0 THEN
  321.     IF Language = Modula2 THEN
  322.       WriteS (f, '(* line ');
  323.       WriteI (f, pos.Line, 0);
  324.       WriteS (f, ' "');
  325.       WriteS (f, SourceFileName);
  326.       WriteS (f, '" *)');
  327.       WriteNl (f);
  328.     ELSE (* Language = C *)
  329.       IF LineFlag THEN
  330.          WriteS (f, '# line ');
  331.          WriteI (f, pos.Line, 0);
  332.          WriteS (f, ' "');
  333.          WriteS (f, SourceFileName);
  334.          WriteC (f, '"');
  335.          WriteNl (f);
  336.       ELSE
  337.          WriteS (f, '/* line ');
  338.          WriteI (f, pos.Line, 0);
  339.          WriteS (f, ' "');
  340.          WriteS (f, SourceFileName);
  341.          WriteS (f, '" */');
  342.          WriteNl (f);
  343.       END;
  344.     END;
  345.       END;
  346.       (* gib die semantische Aktion zeilenweise aus *)
  347.       i1 := 2;
  348.       WHILE NOT IsEmpty (a) DO
  349.     StringMem.GetString (tStringRef (Head (a)), s);
  350.     i2 := Length (s);
  351.     Tail (a);
  352.     IF IsEmpty (a) THEN DEC (i2); END;
  353.     IF Language = Modula2 THEN WriteS (f, '  '); END;
  354.     i := i1;
  355.     WHILE i <= i2 DO
  356.       c := Char (s, i); INC (i);
  357.       IF c = '\' THEN
  358.         WriteC (f, Char (s, i)); INC (i);
  359.       ELSIF (c = '"') OR (c = "'") THEN
  360.         Delimiter := c;
  361.         WriteC (f, c);
  362.         REPEAT
  363.           c := Char (s, i); INC (i);
  364.           WriteC (f, c);
  365.           IF (Language = C) AND (c = '\') THEN
  366.             WriteC (f, Char (s, i)); INC (i);
  367.           END;
  368.         UNTIL c = Delimiter;
  369.       ELSIF c = '$' THEN                (* evtl. Attribute *)
  370.         IF (i <= i2) AND (Char (s, i) = '$') THEN
  371.           WriteS (f, 'yySynAttribute');
  372.           INC (i);
  373.         ELSE
  374.           AttrIndex := 0;
  375.           IF (i <= i2) AND (Char (s, i) = '-') THEN
  376.         negative := TRUE;
  377.         INC (i);
  378.           ELSE
  379.         negative := FALSE;
  380.           END;
  381.           WHILE (i <= i2) AND (Char (s, i) >= '0') AND (Char (s, i) <= '9') DO
  382.         AttrIndex := AttrIndex * 10 + (ORD (Char (s, i)) - ORD('0'));
  383.         INC (i);
  384.           END;
  385.           IF negative OR (AttrIndex <= len) THEN
  386.         IF Language = Modula2 THEN
  387.           WriteS (f, 'yyAttributeStack^[yyStackPtr');
  388.           IF negative THEN WriteS (f, '-'); ELSE WriteS (f, '+'); END;
  389.           WriteI (f, AttrIndex, 0);
  390.           WriteS (f, ']');
  391.         ELSE (* Language = C *)
  392.           WriteS (f, 'yyAttrStackPtr [');
  393.           IF negative THEN WriteS (f, '-'); END;
  394.           WriteI (f, AttrIndex, 0);
  395.           WriteS (f, '-1]');
  396.         END;
  397.           ELSE    (* Index unbrauchbar -> Kopie in Ausgabe *)
  398.         WriteC (f, c);
  399.           END;
  400.         END;
  401.       ELSE
  402.         WriteC (f, c);
  403.       END;
  404.     END;
  405.     i1 := 1;
  406.       END;
  407.       WriteNl (f);
  408.     END WriteSemanticAction;
  409.  
  410.   PROCEDURE WriteProdComment (f: tFile; prod: tProduction);
  411.     VAR i: tIndex;
  412.     BEGIN
  413.       IF Language = Modula2 THEN
  414.     WriteS (f, ' (* ');
  415.       ELSE (* Language = C *)
  416.     WriteS (f, ' /* ');
  417.       END;
  418.  
  419.       WITH prod^ DO
  420.     WriteToken (f, Left);
  421.     WriteS (f, ': ');
  422.     FOR i := 1 TO Len DO
  423.       WriteToken (f, Right[i]);
  424.     END;
  425.     WriteC (f, '.');
  426.       END;
  427.  
  428.       IF Language = Modula2 THEN
  429.     WriteS (f, '*)');
  430.     WriteNl (f);
  431.       ELSE (* Language = C *)
  432.     WriteS (f, '*/');
  433.     WriteNl (f);
  434.       END;
  435.     END WriteProdComment;
  436.  
  437.   PROCEDURE WriteToken (f: tFile; t: Vocabulary);
  438.     VAR
  439.      s: tString;
  440.      sym: tIdent;
  441.      error: TokenError;
  442.      i: CARDINAL;
  443.     BEGIN
  444.       sym := TokenToSymbol (t, error);
  445.       GetString (sym, s);
  446.       WriteC (f, Char (s, 1));
  447.       IF Language = Modula2 THEN
  448.     FOR i := 2 TO Length (s) DO
  449.       IF Char (s, i) = ')' THEN
  450.         IF Char (s, i-1) = '*' THEN
  451.           WriteC (f, ' ');
  452.         END;
  453.       ELSIF Char (s, i) = '*' THEN
  454.         IF Char (s, i-1) = '(' THEN
  455.           WriteC (f, ' ');
  456.         END;
  457.       END;
  458.       WriteC (f, Char (s, i));
  459.     END;
  460.       ELSE (* Language = C *)
  461.     FOR i := 2 TO Length (s) DO
  462.       IF Char (s, i) = '/' THEN
  463.         IF Char (s, i-1) = '*' THEN
  464.           WriteC (f, ' ');
  465.         END;
  466.       ELSIF Char (s, i) = '*' THEN
  467.         IF Char (s, i-1) = '/' THEN
  468.           WriteC (f, ' ');
  469.         END;
  470.       END;
  471.       WriteC (f, Char (s, i));
  472.     END;
  473.       END;
  474.       WriteC (f, ' ');
  475.     END WriteToken;
  476.  
  477.   PROCEDURE WriteLong (f:tFile; Check:LONGINT);
  478.     VAR
  479.       i, j: LONGINT;
  480.       d: CARDINAL;
  481.     BEGIN
  482.       IF Check < 0 THEN
  483.     WriteC (f, '-');
  484.     Check := - Check;
  485.       END;
  486.       i := 1;
  487.       WHILE i <= Check DIV 10 DO
  488.     i := i * 10;
  489.       END;
  490.       WHILE i > 0 DO
  491.     d := Check DIV i;
  492.     WriteC (f, CHR(ORD('0')+d));
  493.     j := d;
  494.     DEC (Check, j * i);
  495.     i := i DIV 10;
  496.       END;
  497.     END WriteLong;
  498.   END GenLang.
  499.